perm filename HAND.SAI[SYS,HE]4 blob
sn#016508 filedate 1972-12-20 generic text, type T, neo UTF8
00100 BEGIN
00200 IFC FALSE THENC "WAVE"
00300 DEFINE WAVE="TRUE",GRAPHICS="FALSE";
00400 ELSEC "HAND"
00500 DEFINE WAVE="FALSE",GRAPHICS="FALSE";
00600 ENDC
00700 REQUIRE -1 NEW_ITEMS;
00800 REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
00900 REQUIRE "DRIVE.REL[SYS,HE]" LOAD_MODULE;
01000 EXTERNAL SIMPLE PROCEDURE ARMPOS;
01100 EXTERNAL SIMPLE PROCEDURE HANDFN;
01200 EXTERNAL SIMPLE PROCEDURE ARMFN(INTEGER NARGS);
01300 EXTERNAL SIMPLE PROCEDURE ARMPROCEED(BOOLEAN REPEAT);
01400 EXTERNAL SIMPLE PROCEDURE DOIT(INTEGER BAND,FILE);
01500 EXTERNAL SIMPLE PROCEDURE ARM_JOINT;
01600 REAL ROTAT;
01700 SAFE REAL ARRAY TRANS[1:4,1:4];
01800 INTERNAL SAFE INTEGER ARRAY ARM_MESSAGE[1:21];
01900 INTEGER IFI,I,J,MESS;
02000 BOOLEAN FRST_OPEN,AEF;
02100 BOOLEAN TEST;
02200 INTEGER N,CHAN;
02300 REAL TX,TY,TZ;
02400 INTEGER HAND;
02500 STRING FILE;
02600 INTEGER BREAK,EOF;
02700 INTEGER NNUL,PTR1,PTR2,PTR3,PTR4;
02800 SAFE REAL ARRAY TH,DIR[1:6];
02900 DEFINE MP="MESSAGE";
03000 PRELOAD_WITH -180.0, -90.0, 12.0, -90.0, 90.0, 0.0;
03100 SAFE REAL ARRAY V0[1:6];
03200 LABEL EXETRUE,GGET,GET,GET1;
03300 DEFINE TTY="1",ONE_LINE="1",HEAD="2",ID="3",DEL="4";
03400 DEFINE OCTNUM="5",RSB="6",LN="7",SOME="10";
03500 DEFINE NUMS="11",NNUMS="12",DOLLAR="13",SOMETHING="14";
03600 DEFINE FREE_DATA_LENGTH="100",MAX_STACK="150";
03700 SAFE INTEGER ARRAY RELOC,STACK[1:MAX_STACK];
00100 IFC WAVE THENC
00200 REQUIRE 2000 STRING_SPACE;
00300 REQUIRE "HASH06.REL[SYS,HE]" LOAD_MODULE;
00400 EXTERNAL SIMPLE INTEGER PROCEDURE HASH(STRING S);
00500 EXTERNAL SIMPLE INTEGER PROCEDURE REHASH;
00600 STRING EDIT_NAME,LINE_NO,S;
00700 SAFE REAL ARRAY XT[1:4,1:4];
00800 SAFE REAL ARRAY XV,YV,ZV[1:4];
00900 STRING ARRAY MACRO_FORMAL,MACRO_NAME,MACRO_SOURCE,MACRO_DEFN,FILE_NAME[1:15];
01000 SAFE INTEGER ARRAY MAC_TOP[0:14];
01100 INTEGER FMN,MAC_EOF,MAC,MAC_FREE;
01200 DEFINE MAX_PAR="30";
01300 SAFE STRING ARRAY MAC_PAR[1:MAX_PAR];
01400 DEFINE MAX_LABELS="100";
01500 STRING ARRAY LABEL_LINE,LABELS[1:MAX_LABELS];
01600 INTEGER ARRAY BBEG,LLAB[0:15];
01700 INTEGER FREEL;
01800 INTEGER ARRAY PTRS[1:MAX_LABELS];
01900 STRING ARRAY CODE_LINE,REF[1:MAX_STACK];
02000 STRING ARRAY FUNNAM[0:'77];
02100 INTEGER ARRAY FUNNUM[0:'77];
02200 STRING ARRAY VECTNAM[0:'77];
02300 STRING ARRAY TRANSNAM[0:'77];
02400 INTEGER ARRAY TRANSNUM[0:'77];
02500 INTEGER ARRAY VECTNUM[0:'77];
02600 SAFE STRING ARRAY SAVE_NAME[1:10];INTEGER MSN;
02700 SAFE REAL ARRAY DATA_BASE[0:FREE_DATA_LENGTH,1:3];
02800 INTEGER FREE_DATA;
02900 SIMPLE STRING PROCEDURE SIMIO(REFERENCE INTEGER BR);
03000 BEGIN STRING S;
03100 IF MAC
03200 THEN BEGIN S←SCAN(MACRO_SOURCE[MAC],BR,BREAK);
03300 MAC_EOF←¬(LENGTH(MACRO_SOURCE[MAC]) ∨ LENGTH(S)) END
03400 ELSE S←INPUT(CHAN,BR);
03500 RETURN(S) END"SIMIO";
03600
00100 SIMPLE INTEGER PROCEDURE GETNAME(BOOLEAN NUM;REFERENCE STRING S;STRING ARRAY NAME);
00200 BEGIN LABEL L1;
00250 STRING SN;
00300 INTEGER I;
00400 L1: IF NUM THEN SIMIO(NUMS) ELSE SIMIO(HEAD);
00500 IF MAC_EOF
00600 THEN BEGIN
00700 FOR I←LLAB[MAC] STEP 1 UNTIL FREEL
00800 DO FOR J←BBEG[MAC] STEP 1 UNTIL PTR3
00900 DO IF EQU(REF[J],LABELS[I])
01000 THEN BEGIN
01100 START_CODE
01200 MOVE 1,STACK;
01300 ADD 1,J;
01400 HRRE 1,-1(1);
01500 MOVEM 1,N END;
01600 N←PTRS[I]-J+N;
01700 REF[J]←NULL;
01800 IF N+J<1 ∨ N+J>PTR3+1
01900 THEN BEGIN
02000 OUTSTR(CODE_LINE[J]&"JUMP OUT OF RANGE"&'15&'12);
02100 N←PTR3+1-J END;
02200 STACK[J]←(N LAND '777777) LOR (STACK[J] LAND '777000000) END;
02300 MAC_FREE←MAC_TOP[MAC];
02400 FREEL←LLAB[MAC]-1;
02500 MAC←MAC-1;
02600 MAC_EOF←0;
02700 IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*")END;
02800 GO TO L1 END;
02900 IF EOF THEN BEGIN RELEASE(CHAN);
03000 CHAN←CHAN-1;
03100 IF ¬MAC ∧ CHAN=1 THEN BEGIN LINE_NO←NULL;OUTSTR("*")END;
03200 GO TO L1; END;
03300 IF BREAK=-1
03400 THEN BEGIN LINE_NO←SIMIO(LN);
03500 GO TO L1 END;
03600 IF BREAK=";" THEN BEGIN SIMIO(ONE_LINE); GO TO L1 END;
03700 IF BREAK="$"
03800 THEN BEGIN I←INTSCAN(S←SIMIO(NNUMS),J);
03900 I←I+MAC_TOP[MAC];
04000 IF I<1 ∨ I> MAC_FREE
04100 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
04200 GO TO L1 END;
04300 S←MAC_PAR[I] END
04400 ELSE S←IF NUM THEN SIMIO(NNUMS) ELSE SIMIO(ID);
04500 IF NUM THEN BEGIN
04510 SN←SCAN(S,DOLLAR,J);
04515 IF J="$" THEN BEGIN
04520 I←INTSCAN(S,J);
04533 I←I+MAC_TOP[MAC];
04546 IF I<1 ∨ I> MAC_FREE
04559 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
04572 GO TO L1 END;
04585 S←SN&MAC_PAR[I] END ELSE S←SN;
04592 RETURN(-1) END;
04600 IF BREAK=":"
04700 THEN BEGIN
04800 FOR I←LLAB[MAC] STEP 1 UNTIL FREEL
04900 DO IF EQU(S,LABELS[I])
05000 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&S&" MULTIPLY DEFINED LABEL"&'15&'12);
05100 GO TO L1 END;
05200 LABELS[FREEL←FREEL+1]←S;
05300 LABEL_LINE[FREEL]←FILE_NAME[CHAN]&LINE_NO;
05400 PTRS[FREEL]←PTR3+1;
05500 GO TO L1 END;
05600 I←HASH(S);
05700 WHILE LENGTH(NAME[I])
05800 DO BEGIN IF EQU(S,NAME[I]) THEN DONE;
05900 I←REHASH END;
06000 RETURN(I) END;
06100
00100 STRING WAIT,LFILE,OFILE,SL;
00200 SIMPLE PROCEDURE OPEN_ONE;
00300 IF ¬(LENGTH(FILE) ∨ AEF) THEN START_TRAJECTORY ((LFILE←FILE←OFILE),0);
00400
00500 FORWARD SIMPLE PROCEDURE CONSTRUCT(REAL ARRAY T,E);
00600
00700 SIMPLE INTEGER PROCEDURE INTERN(STRING S;STRING ARRAY NAME);
00800 BEGIN INTEGER I;
00900 I←HASH(S);
01000 WHILE LENGTH(NAME[I])
01100 DO BEGIN IF EQU(S,NAME[I]) THEN RETURN(I);
01200 I←REHASH END;
01300 NAME[I]←S;
01400 RETURN(I) END;
01500
01600 DEFINE SAY_WAIT="IF ¬MAC ∧ CHAN=1 THEN OUTSTR(WAIT&'15&'12)";
01700
01800 BOOLEAN SIMPLE PROCEDURE READT(REAL ARRAY T;REFERENCE STRING S;STRING MESS);
01900 BEGIN INTEGER I;
02000 SAFE OWN REAL ARRAY E[1:6];
02100 I←GETNAME(FALSE,S,TRANSNAM);
02200 IF LENGTH(TRANSNAM[I])
02300 THEN BEGIN ARRBLT(E[1],DATA_BASE[TRANSNUM[I],1],6);
02400 CONSTRUCT(T,E);
02500 RETURN(TRUE) END;
02600 OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
02700 RETURN(FALSE) END;
02800
02900 BOOLEAN SIMPLE PROCEDURE READV(REAL ARRAY V;REFERENCE STRING S;STRING MESS);
03000 BEGIN INTEGER I;
03100 I←GETNAME(FALSE,S,VECTNAM);
03200 IF LENGTH(VECTNAM[I])
03300 THEN BEGIN ARRBLT(V[1],DATA_BASE[VECTNUM[I],1],3);
03400 V[4]←1;
03500 RETURN(TRUE) END;
03600 OUTSTR(FILE_NAME[CHAN]&LINE_NO&MESS&'15&'12);
03700 RETURN(FALSE) END;
03800
03900 SAFE REAL ARRAY TT1[1:4,1:4];
04000 PRELOAD_WITH 20,30,1,180,90,0; SAFE REAL ARRAY ANEW[1:6];
04100 IFC GRAPHICS THENC
04200 REQUIRE"DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
04300 ENDC
04400 STRING FUNCTION,S11,SM,DFILE;
04500 PRELOAD_WITH 100.0, 100.0, 100.0, 100.0, 100.0, 100.0;
04600 SAFE REAL ARRAY THFAC[1:6];
04700 ENDC
00100 REAL R;
00200 SAFE REAL ARRAY VT,VT1,VT2[1:4];
00300 PRELOAD_WITH [2] 0.0, [2] 1.0;
00400 SAFE REAL ARRAY UZ[1:4];
00500 SAFE REAL ARRAY ST[1:6];
00600 INTEGER NMASK,TIP,PAD,HIT,LL,UL,MODULUS,PTR,TIME,INDEX,BP;
00700 REAL FACTOR;
00800 PRELOAD_WITH 0;
00900 SAFE INTEGER ARRAY BUFFER[0:100];
01000 IFC WAVE THENC
01100 ENDC
01200
01300 REQUIRE "TRAJ.SAI" SOURCE_FILE;
01400
00100 IFC WAVE THENC
00200 SIMPLE PROCEDURE CONSTRUCT(REAL ARRAY T,E);
00300 BEGIN
00400 REAL SI1,SI2,SI3,CO1,CO2,CO3;
00500 T[1,4]←E[1]*TSX;
00600 T[2,4]←E[2]*TSY;
00700 T[3,4]←E[3];
00800 SI1←SIND(E[4]);CO1←COSD(E[4]);
00900 SI2←SIND(E[5]);CO2←COSD(E[5]);
01000 SI3←SIND(E[6]);CO3←COSD(E[6]);
01100 T[1,1]←-SI1*SI2*CO3+CO1*SI3;
01200 T[1,2]← SI1*SI2*SI3+CO1*CO3;
01300 T[2,1]← CO1*SI2*CO3+SI1*SI3;
01400 T[2,2]←-CO1*SI2*SI3+SI1*CO3;
01500 T[1,3]← SI1*CO2;
01600 T[2,3]←-CO1*CO2;
01700 T[3,1]←-CO2*CO3;
01800 T[3,2]← CO2*SI3;
01900 T[3,3]←-SI2;
02000 T[4,1]←T[4,2]←T[4,3]←0;
02100 T[4,4]←1;
02200 END;
02300
02400 ENDC
00100 FORMAT_POINTER←-1;
00200 RESET_CONO;
00300 AEF←ARM_EXECUTE←FALSE;
00400 PUSH_FORMAT(8,4);
00500 ARM_SEGMENT←0;
00600 ARM_MOTION←0;
00700 FAST←TRUE;
00800 FOR I←0 STEP 1 UNTIL '37 DO BANDS[I]←NULL;
00900 NEXT_BAND←0;
01000 STOP_ON_TOUCH←FALSE;
01100 FOR I←1 STEP 1 UNTIL 6 DO MMOVE(A[SQAR(I)],A[SQAR(I)]);
01200
01300 MMOVE(Q[0],Q[0]);
01400 MMOVE(Q[17],Q[17]);
01500 FOR I←1 STEP 1 UNTIL 3 DO DEPART_ARM[I]←ARRIVE_ARM[I]←IF I=3 THEN 3.0 ELSE 0.0;
01600 DEPART_ARM[4]←ARRIVE_ARM[4]←1.0;
01700 FOR I←1 STEP 1 UNTIL 6 DO BEGIN
01800 N←SQAR(I);
01900 MMOVE(JMAT[N],JMAT[N])END ;
02000 DO BEGIN
02100 ARM_POSITION;
02200 IF ARM_STATUS THEN
02300 BEGIN OUTSTR("HAND ERROR "&CVOS(ARM_STATUS)&"
02400 CHECK PDP-6 AND TYPE C/R"&CRLF);
02500 INCHWL;
02600 END;
02700 END UNTIL ¬ARM_STATUS;
02800 ARRTRAN(LAST_ARM,ARM_VECTOR);
02900 PUT_DATA(0,0,"HAND");
03000 YES_HAND←-1;
03100 IFC ¬WAVE THENC
03200 OUTSTR(" ***** HAND INITIALIZED *****"&'15&'12);
03300 WHILE TRUE DO QUEUE('600, GET_ENTRY('120,NULL,"HAND",NULL));
00100 ELSEC
00200 WAIT←"O.K.";
00300 OPEN(TTY,"TTY",0,2,0,120,BREAK,EOF);
00400 EDIT_NAME←LFILE←FILE←NULL;
00500 FREEL←0;
00600 FOR I←0 STEP 1 UNTIL 15 DO LLAB[I]←1;
00700 OFILE←"WAVE";
00800 SETBREAK(ONE_LINE,'12,'15,"IN");
00900 SETBREAK(SOME,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRD");
01000 SETBREAK(SOMETHING,"0123456789.@+-;$ABCDEFGHIJKLMNOPQRSTUVWXYZ"&'12,'15,"ILRD");
01100 SETBREAK(HEAD,"$;ABCDEFGHIJKLMNOPQRSTUVWXYZ",NULL,"ILRD");
01200 SETBREAK(ID,"ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789_",NULL,"XN");
01300 SETBREAK(RSB,"]",NULL,"IAN");
01400 SETBREAK(DEL,"() ,;: ",NULL,"IN");
01500 SETBREAK(NUMS,"0123456789.@+-$;",NULL,"ILR");
01600 SETBREAK(NNUMS,"$0123456789.@+-",NULL,"XL");
01700 SETBREAK(DOLLAR,"$",NULL,"I");
01800 SETBREAK(LN," ",NULL,"IA");
01900 NMASK←'777777774000;
02000 CHAN←TTY;
02100 MSN←FMN←MAC←MAC_EOF←EOF←MAC_FREE←0;
02200 FUNNUM[INTERN("DO",FUNNAM)]←0;
02300 FUNNUM[INTERN("REQUIRE",FUNNAM)]←1;
02400 FUNNUM[INTERN("TRANS",FUNNAM)]←2;
02500 FUNNUM[INTERN("VECT",FUNNAM)]←3;
02600 FUNNUM[INTERN("BEGIN",FUNNAM)]←4;
02700 FUNNUM[INTERN("PARK",FUNNAM)]←5;
02800 FUNNUM[INTERN("MOVE",FUNNAM)]←6;
02900 FUNNUM[INTERN("STEP",FUNNAM)]←7;
03000 FUNNUM[INTERN("DRAW",FUNNAM)]←8;
03100 FUNNUM[INTERN("FREE",FUNNAM)]←9;
03200 FUNNUM[INTERN("SPIN",FUNNAM)]←10;
03300 FUNNUM[INTERN("FORCE",FUNNAM)]←11;
03400 FUNNUM[INTERN("STOP",FUNNAM)]←12;
03500 FUNNUM[INTERN("OPEN",FUNNAM)]←13;
03600 FUNNUM[INTERN("SKIPE",FUNNAM)]←14;
03700 FUNNUM[INTERN("JUMP",FUNNAM)]←15;
03800 FUNNUM[INTERN("CLOSE",FUNNAM)]←16;
03900 FUNNUM[INTERN("CENTER",FUNNAM)]←17;
04000 FUNNUM[INTERN("PLACE",FUNNAM)]←18;
04100 FUNNUM[INTERN("CHANGE",FUNNAM)]←19;
04200 FUNNUM[INTERN("DRIVE",FUNNAM)]←20;
04300 FUNNUM[INTERN("WAIT",FUNNAM)]←21;
04400 FUNNUM[INTERN("MERGE",FUNNAM)]←22;
04500 FUNNUM[INTERN("SAVE",FUNNAM)]←23;
04600 FUNNUM[INTERN("RESTORE",FUNNAM)]←24;
04700 FUNNUM[INTERN("TOUCH",FUNNAM)]←25;
04800 FUNNUM[INTERN("CONO",FUNNAM)]←26;
04900 FUNNUM[INTERN("END",FUNNAM)]←27;
05000 FUNNUM[INTERN("FLUSH",FUNNAM)]←28;
05100 FUNNUM[INTERN("P",FUNNAM)]←29;
05200 FUNNUM[INTERN("PROTOTYPE",FUNNAM)]←30;
05300 FUNNUM[INTERN("FILE",FUNNAM)]←31;
05400 FUNNUM[INTERN("I",FUNNAM)]←32;
05500 FUNNUM[INTERN("MOVE_INSTANCE",FUNNAM)]←33;
05600 FUNNUM[INTERN("LINK",FUNNAM)]←34;
05700 FUNNUM[INTERN("GRASP",FUNNAM)]←35;
05800 FUNNUM[INTERN("WEIGHT",FUNNAM)]←36;
05900 FUNNUM[INTERN("WOBBLE",FUNNAM)]←37;
06000 FUNNUM[INTERN("POSITION",FUNNAM)]←38;
06100 FUNNUM[INTERN("SKIPN",FUNNAM)]←39;
06200 FUNNUM[INTERN("SKIPS",FUNNAM)]←40;
06300 FUNNUM[INTERN("DEFINE",FUNNAM)]←41;
06400 FUNNUM[INTERN("DUMP",FUNNAM)]←42;
06500 FUNNUM[INTERN("SET",FUNNAM)]←43;
06600 FUNNUM[INTERN("ED",FUNNAM)]←44;
06700 FUNNUM[INTERN("NNUL",FUNNAM)]←45;
06800 FUNNUM[INTERN("SEARCH",FUNNAM)]←46;
06900 FUNNUM[INTERN("AOJ",FUNNAM)]←47;
07000 FUNNUM[INTERN("SLAVE",FUNNAM)]←48;
07100 IFC GRAPHICS THENC FUNNUM[INTERN("DISP",FUNNAM)]←49;ENDC
07200 VECTNUM[INTERN("SWEEP",VECTNAM)]←0;
07300 VECTNUM[INTERN("LIFT",VECTNAM)]←0;
07400 VECTNUM[INTERN("REACH",VECTNAM)]←0;
07500 VECTNUM[INTERN("TURN",VECTNAM)]←0;
07600 VECTNUM[INTERN("TWIST",VECTNAM)]←0;
07700 VECTNUM[INTERN("TILT",VECTNAM)]←0;
07800 VECTNUM[INTERN("NIL",VECTNAM)]←1;
07900 FREE_DATA←2;
08000 OUTSTR("WAVE READY!
08100 DO YOU WANT THE FILES SAVED? Y OR N
08200 ");
08300 DO BEGIN
08400 S←INCHWL;
08500 IF S="Y" THEN FAST←FALSE;
08600 IF S="N" THEN FAST←TRUE;
08700 END UNTIL S="Y" ∨ S="N";
08800 GO TO GET1;
08900
09000 GET:SIMIO(ONE_LINE);
09100 GET1:SETFORMAT(7,2);
09200 GGET:
09300 IF AEF ∧ ARM_STATUS THEN BEGIN
09400 OUTSTR("ARM_STATUS"&CVOS(ARM_STATUS)&CRLF);
09500 MAC_FREE←MAC←MAC_EOF←0;
09600 FOR CHAN←CHAN STEP -1 UNTIL 2 DO RELEASE(CHAN);
09700 END;
09800 IF ¬MAC ∧ CHAN=1 THEN OUTSTR("*"&CRLF);
09900 AEF←FALSE;
10000 I←GETNAME(FALSE,S,FUNNAM);
10100 IF LENGTH(FUNNAM[I]) THEN EXETRUE:CASE FUNNUM[I] OF BEGIN
00100 BEGIN "DOIT"
00200 ARM_EXECUTE←AEF←TRUE;
00300 IF BREAK≠'15
00400 THEN BEGIN I←GETNAME(FALSE,S,FUNNAM);
00500 IF LENGTH(FUNNAM[I]) THEN GO TO EXETRUE ELSE LFILE←S END
00600 ELSE S←LFILE;
00700 SAY_WAIT;
00800 IF LENGTH(FILE) THEN BEGIN
00900 CLOSE_TRAJECTORY;
01000 FILE←NULL;
01100 END;
01200 DO_IT(S);
01300 GO TO GET1;
01400 END"DOIT";
01500
01600 BEGIN "REQUIRE"
01700 SIMIO(HEAD);
01800 FILE_NAME[CHAN+1]←(S←SIMIO(ID))&'11;
01900 IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".HAL";
02000 IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
02100 OPEN(CHAN+1,"DSK",0,2,0,120,BREAK,EOF);
02200 LOOKUP(CHAN+1,S,EOF);
02300 IF EOF≠0 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&" "&LINE_NO&"FILE NOT FOUND"&CRLF);
02400 RELEASE(CHAN+1);GO TO GET END;
02500 IF CHAN=1 ∧ ¬MAC THEN SAY_WAIT;
02600 CHAN←CHAN+1;
02700 GO TO GET1;
02800 END "REQUIRE";
02900
03000
03100 BEGIN "TRANS"
03200 INTEGER PTR;
03300 SAFE OWN REAL ARRAY E[1:6];
03400 SAFE OWN REAL ARRAY VT,VTT[1:4];
03500 PTR←GETNAME(FALSE,S,TRANSNAM);
03600 IF ¬LENGTH(TRANSNAM[PTR])
03700 THEN BEGIN
03800 IF FREE_DATA+2>FREE_DATA_LENGTH
03900 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
04000 TRANSNAM[PTR]←S;
04100 TRANSNUM[PTR]←FREE_DATA;
04200 ARRBLT(E[1],ANEW[1],6);
04300 FREE_DATA←FREE_DATA+2 END
04400 ELSE ARRBLT(E[1],DATA_BASE[TRANSNUM[PTR],1],6);
04500 IF ¬MAC ∧ CHAN=1
04600 THEN BEGIN OUTSTR(" X Y Z O A T"&CRLF);
04700 FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(E[I]));
04800 OUTSTR(CRLF&"CHANGE?"&CRLF);
04900 SIMIO(ONE_LINE);
05000 S←SIMIO(ONE_LINE);
05100 FOR I←1 STEP 1 UNTIL 6 DO
05200 IF LENGTH(S) THEN BEGIN
05300 SL←SCAN(S,DEL,IFI);
05400 R←REALSCAN(SL,IFI);
05500 IF IFI≠-1 THEN E[I]←R;
05600 END;
05700 END ELSE FOR I←1 STEP 1 UNTIL 6 DO BEGIN
05800 GETNAME(TRUE,S,VECTNAM);
05900 E[I]←REALSCAN(S,BREAK) END;
06000 ARRBLT(DATA_BASE[TRANSNUM[PTR],1],E[1],6);
06100 IF ¬MAC ∧ CHAN=1
06200 THEN BEGIN CONSTRUCT(TT1,E);
06300 TT1[1,4]←TT1[1,4]/TSX;
06400 TT1[2,4]←TT1[2,4]/TSY;
06500 PMAT(NULL,TT1) END;
06600 GO TO GET1;
06700 END"TRANS";
06800
06900 BEGIN "VECT"
07000 INTEGER PTR;
07100 PTR←GETNAME(FALSE,S,VECTNAM);
07200 IF ¬LENGTH(VECTNAM[PTR])
07300 THEN BEGIN
07400 IF FREE_DATA+1>FREE_DATA_LENGTH
07500 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE DATA"&CRLF);GO TO GET END;
07600 VECTNAM[PTR]←S;
07700 VECTNUM[PTR]←FREE_DATA;
07800 FOR I←1 STEP 1 UNTIL 3 DO XV[I]←0;
07900 FREE_DATA←FREE_DATA+1 END
08000 ELSE ARRBLT(XV[1],DATA_BASE[VECTNUM[PTR],1],3);
08100 XV[4]←1;
08200 IF ¬MAC ∧ CHAN=1
08300 THEN BEGIN PVECT(NULL,XV);
08400 OUTSTR("CHANGE ?"&CRLF);
08500 SIMIO(ONE_LINE);
08600 S←SIMIO(ONE_LINE);
08700 FOR I←1 STEP 1 UNTIL 3 DO
08800 IF LENGTH(S) THEN BEGIN
08900 SL←SCAN(S,DEL,IFI);
09000 R←REALSCAN(SL,IFI);
09100 IF IFI≠-1 THEN XV[I]←R;
09200 END;
09300 END ELSE FOR I←1 STEP 1 UNTIL 3 DO BEGIN
09400 GETNAME(TRUE,S,VECTNAM);
09500 XV[I]←REALSCAN(S,BREAK) END;
09600 ARRBLT(DATA_BASE[VECTNUM[PTR],1],XV[1],3);
09700 IF ¬MAC ∧ CHAN=1 THEN PVECT(NULL,XV);
09800 GO TO GET1;
09900 END "VECT";
10000
00100 BEGIN "BEGIN"
00200 IF FILE THEN CLOSE_TRAJECTORY ;
00300 GETNAME(FALSE,LFILE,VECTNAM);
00400 FILE←LFILE;
00500 SAY_WAIT;
00600 START_TRAJECTORY(FILE,0);
00700 END"BEGIN";
00800
00900 BEGIN "PARK"
01000 SAY_WAIT;
01100 OPEN_ONE;
01200 PARK_ARM;
01300 END"PARK";
01400
01500 BEGIN "MOVE"
01600 REAL DIST,DEG;
01700 IF READT(TT1,S,"MOVE - "&S&" TRANSFORM DOSN'T EXIST")
01800 THEN BEGIN SIMIO(SOMETHING);
01900 IF BREAK≠'12 ∧ BREAK≠";" THEN BEGIN
02000 IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
02100 J←0;
02200 IF EQU(S,"SWEEP")THEN J←2;
02300 IF EQU(S,"REACH")THEN J←3;
02400 IF EQU(S,"LIFT")THEN J←1;
02500 IF J THEN FOR I←1 STEP 1 UNTIL 3 DO XV[I]←TT1[J,I];
02600 GETNAME(TRUE,S,FUNNAM);
02700 DIST←REALSCAN(S,BREAK);
02800 IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
02900 J←0;
03000 IF EQU(S,"TURN")THEN J←1;
03100 IF EQU(S,"TWIST")THEN J←3;
03200 IF EQU(S,"TILT")THEN J←2;
03300 IF J THEN FOR I←1 STEP 1 UNTIL 3 DO YV[I]←TT1[J,I];
03400 GETNAME(TRUE,S,FUNNAM);
03500 DEG←REALSCAN(S,BREAK);
03600 SCALE(XV,XV,DIST);
03700 REDUCE(XV);
03800 XV[1]←XV[1]*TSX;XV[2]←XV[2]*TSY;
03900 FOR J←1 STEP 1 UNTIL 3 DO TT1[J,4]←TT1[J,4]+XV[J];
04000 IF DEG ∧ MAGNITUDE(YV) THEN BEGIN
04100 FOR I←1 STEP 1 UNTIL 3 DO BEGIN
04200 CVV(XV,TT1,I);
04300 REVOLVE(XV,YV,DEG);
04400 CVC(TT1,I,XV) END;
04500 END;
04600 END;
04700 SAY_WAIT;
04800 OPEN_ONE;
04900 MOVE_ARM(TT1,ARM_PLAN);
05000 IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNABLE TO MOVE"&CRLF)END
05100 END"MOVE";
05200
05300 BEGIN"STEP"
05400 GETNAME(TRUE,S,FUNNAM);
05500 I←INTSCAN(S,BREAK);
05600 GETNAME(TRUE,S,FUNNAM);
05700 R←REALSCAN(S,BREAK);
05800 GETNAME(TRUE,S,FUNNAM);
05900 J←INTSCAN(S,BREAK);
06000 SAY_WAIT;
06100 OPEN_ONE;
06200 IF 1≤ I ≤6 THEN STEP_ARM(I,R,J) ELSE OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
06300 END"STEP";
06400
06500 BEGIN "DRAW"
06600 INTEGER I;
06700 SAFE OWN REAL ARRAY PROFILE[1:5,1:4];
06800 SAFE OWN REAL ARRAY DP[1:4];
06900 EXTERNAL SIMPLE PROCEDURE MOVEV(REFERENCE REAL R;REAL ARRAY S);
07000 IF ¬MAC ∧ CHAN=1 THEN BEGIN OUTSTR("POSITION,ROTATION,ANGLE
07100 CRANK,AXIS,DEGREES
07200 TIME,LOOP"&CRLF);
07300 SIMIO(ONE_LINE) END;
07400 IF ¬READV(XV,S,"NEW POSITION MISSING") THEN GO TO GET;
07500 MOVEV(DP[1],XV);
07600 REDUCE(DP);
07700 DP[1]←DP[1]*TSX;
07800 DP[2]←DP[2]*TSY;
07900 MOVEV(PROFILE[1,1],DP);
08000 IF ¬READV(YV,S,"ROTATION AXIS MISSING") THEN GO TO GET;
08100 MOVEV(PROFILE[2,1],YV);
08200 GETNAME(TRUE,S,FUNNAM);
08300 PROFILE[3,1]←REALSCAN(S,BREAK);
08400 IF ¬(READV(XV,S,"CRANK MISSING") ∧ READV(YV,S,"AXIS MISSING"))THEN GO TO GET;
08500 GETNAME(TRUE,S,FUNNAM);
08600 PROFILE[3,2]←REALSCAN(S,BREAK);
08700 MOVEV(PROFILE[4,1],XV);
08800 MOVEV(PROFILE[5,1],YV);
08900 GETNAME(TRUE,S,FUNNAM);
09000 ARM_STAT[2]←INTSCAN(S,BREAK);
09100 GETNAME(TRUE,S,FUNNAM);
09200 ARM_STAT[3]←INTSCAN(S,BREAK);
09300 IF ARM_STAT[3] ∧ ¬(ABS(PROFILE[3,2])=360 ∨ ABS(PROFILE[3,1])=360)
09400 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNLOOPABLE
09500 "); GO TO GET END;
09600 SAY_WAIT;
09700 OPEN_ONE;
09800 DRAW_ARM(ARM_STAT,PROFILE);
09900 IF ARM_STAT[1] THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"DRAW - SORRY"&CVOS(ARM_STAT[1])&CRLF);
10000 END"DRAW";
10100
00100 BEGIN"FREE"
00200 GETNAME(TRUE,S,FUNNAM);
00300 J←INTSCAN(S,BREAK);
00400 FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
00500 BEGIN
00600 FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
00700 IF READV(XV,S,"MISSING FREE")
00800 THEN BEGIN REDUCE(XV);
00900 ARRBLT(FREE_ARM[I,1],XV[1],3)END;
01000 END;
01100 FREE_ARM[0,1]←FREE_ARM[0,1]+J;
01200 END"FREE";
01300
01400 BEGIN"SPIN"
01500 GETNAME(TRUE,S,FUNNAM);
01600 J←INTSCAN(S,BREAK);
01700 FOR I←FREE_ARM[0,1]+1 STEP 1 UNTIL FREE_ARM[0,1]+J DO
01800 BEGIN
01900 FREE_ARM[I,1]←0;ARRBLT(FREE_ARM[I,2],FREE_ARM[I,1],5);
02000 IF READV(XV,S,"MISSING FREE")
02100 THEN BEGIN REDUCE(XV);
02200 ARRBLT(FREE_ARM[I,4],XV[1],3)END;
02300 END;
02400 FREE_ARM[0,1]←FREE_ARM[0,1]+J;
02500 END"SPIN";
02600
02700 BEGIN"FORCE"
02800 IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
02900 THEN BEGIN REDUCE(XV);
03000 ARRBLT(FORCE_ARM[1],XV[1],3);
03100 REDUCE(YV);
03200 ARRBLT(FORCE_ARM[4],YV[1],3) END;
03300 END"FORCE";
03400
03500 BEGIN "STOP"
03600 IF (READV(XV,S,"MISSING FORCE") ∧ READV(YV,S,"MISSING MOMENT"))
03700 THEN BEGIN SAY_WAIT;
03800 OPEN_ONE;
03900 STOP_ARM(XV,YV,ARM_PLAN);
04000 IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF) END;
04100 END"STOP";
04200
00100 BEGIN"OPEN_HAND"
00200 GETNAME(TRUE,S,FUNNAM);
00300 R←REALSCAN(S,BREAK);
00400 SAY_WAIT;
00500 OPEN_ONE;
00600 OPEN_HAND(R);
00700 END"OPEN_HAND";
00800
00900 BEGIN"SKIPE"
01000 STRING SL;
01100 SL←SIMIO(ONE_LINE);
01200 I←CVO(SL);
01300 SAY_WAIT;
01400 ARM_SKIPE(I);
01500 GO TO GET1
01600 END"SKIPE";
01700
01800 BEGIN"JUMP"
01900 STRING SC;
02000 CODE_LINE[PTR3+1]←LINE_NO;
02100 S←SC←SIMIO(ONE_LINE);
02200 SCAN(SC,HEAD,J);
02300 IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
02400 THEN BEGIN SC←BREAK&SC;
02500 I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
02600 SAY_WAIT;
02700 OPEN_ONE;
02800 ARM_JMP(I);
02900 GO TO GET1;
03000 END"JUMP";
03100
03200 BEGIN "CLOSE_HAND"
03300 GETNAME(TRUE,S,FUNNAM);
03400 R←REALSCAN(S,BREAK);
03500 SAY_WAIT;
03600 OPEN_ONE;
03700 CLOSE_HAND(R);
03800 END"CLOSE_HAND";
03900
04000 BEGIN "CENTER"
04100 SAFE OWN REAL ARRAY DIR[1:4];
04200 GETNAME(TRUE,S,FUNNAM);
04300 R←REALSCAN(S,BREAK);
04400 SAY_WAIT;
04500 OPEN_ONE;
04600 CENTER_HAND(R);
04700 END"CENTER";
04800
04900 BEGIN "PLACE"
05000 SAY_WAIT;
05100 OPEN_ONE;
05200 PLACE_ARM;
05300 END"PLACE";
05400
00100 BEGIN"CHANGE"
00200 REAL DIST,DEG;
00300 INTEGER TIME;
00400 OPEN_ONE;
00500 IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
00600 J←0;
00700 IF EQU(S,"SWEEP")THEN J←2;
00800 IF EQU(S,"REACH")THEN J←3;
00900 IF EQU(S,"LIFT")THEN J←1;
01000 IF J THEN IF AEF THEN FOR I←1 STEP 1 UNTIL 3 DO XV[I]←ARM_LINK[6,I,J]
01100 ELSE CVV(XV,LAST_TRANS,J);
01200 GETNAME(TRUE,S,FUNNAM);
01300 DIST←REALSCAN(S,BREAK);
01400 IF ¬READV(YV,S,"AXIS DOSN'T EXIST")THEN GO TO GET;
01500 J←0;
01600 IF EQU(S,"TURN")THEN J←1;
01700 IF EQU(S,"TWIST")THEN J←3;
01800 IF EQU(S,"TILT")THEN J←2;
01900 IF J THEN IF AEF THEN FOR I←1 STEP 1 UNTIL 3 DO YV[I]←ARM_LINK[6,I,J]
02000 ELSE CVV(YV,LAST_TRANS,J);
02100 GETNAME(TRUE,S,FUNNAM);
02200 DEG←REALSCAN(S,BREAK);
02300 GETNAME(TRUE,S,FUNNAM);
02400 TIME←INTSCAN(S,BREAK);
02500 SAY_WAIT;
02600 CHANGE_ARM(XV,DIST,YV,DEG,TIME,ARM_PLAN);
02700 IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"CAREFUL"&CRLF);
02800 END"CHANGE";
02900
03000 BEGIN"DRIVE"
03100 GETNAME(TRUE,S,FUNNAM);
03200 I←INTSCAN(S,BREAK);
03300 GETNAME(TRUE,S,FUNNAM);
03400 R←REALSCAN(S,BREAK);
03500 GETNAME(TRUE,S,FUNNAM);
03600 J←INTSCAN(S,BREAK);
03700 SAY_WAIT;
03800 OPEN_ONE;
03900 DRIVE_ARM(I,R,J,ARM_PLAN);
04000 IF ¬ARM_PLAN THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY"&CRLF);
04100 END"DRIVE";
04200
04300 BEGIN"WAIT"
04400 SAY_WAIT;
04500 WAIT_ARM;
04600 END"WAIT";
04700
04800 BEGIN"MERGE"
04900 SAY_WAIT;
05000 MERGE_ARM;
05100 END"MERGE";
05200
05300 BEGIN"SAVE"
05400 LABEL L1;
05500 GETNAME(FALSE,S,VECTNAM);
05600 FOR I←1 STEP 1 UNTIL MSN DO IF EQU(S,SAVE_NAME[I]) THEN GO TO L1;
05700 FOR I←1 STEP 1 UNTIL 10 DO IF ¬LENGTH(SAVE_NAME[I])
05800 THEN BEGIN SAVE_NAME[I]←S;
05900 IF I>MSN THEN MSN←I;
06000 GO TO L1 END;
06100 OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE SAVE CELL"&CRLF);
06200 GO TO GET;
06300 L1: SAY_WAIT;
06400 OPEN_ONE;
06500 ARM_SAVE(I);
06600 END"SAVE";
06700
06800 BEGIN"RESTORE"
06900 LABEL L1;
07000 GETNAME(FALSE,S,VECTNAM);
07100 FOR I←1 STEP 1 UNTIL MSN DO IF EQU(S,SAVE_NAME[I]) THEN GO TO L1;
07200 OUTSTR(FILE_NAME[CHAN]&LINE_NO&S&" NOT SAVE CELL"&CRLF);
07300 GO TO GET;
07400 L1: GETNAME(TRUE,S,FUNNAM);
07500 IF INTSCAN(S,BREAK)
07600 THEN BEGIN SAVE_NAME[I]←NULL;
07700 IF I=MSN THEN MSN←MSN-1 END;
07800 SAY_WAIT;
07900 OPEN_ONE;
08000 ARM_RESTORE(I);
08100 END"RESTORE";
08200
08300 BEGIN "TOUCH"
08400 GETNAME(TRUE,S,FUNNAM);
08500 I←INTSCAN(S,BREAK);
08600 SAY_WAIT;
08700 OPEN_ONE;
08800 SET_TOUCH(I);
08900 END"TOUCH";
09000
09100 BEGIN"CONO"
09200 IF (READV(XV,S,"ARRIVE DOES NOT EXIST")
09300 ∧ READV(YV,S,"DEPART DOES NOT EXIST")
09400 ∧ READV(ZV,S,"OBJECT DOES NOT EXIST"))
09500 THEN BEGIN
09600 GETNAME(TRUE,S,FUNNAM);
09700 ZV[4]←REALSCAN(S,BREAK);
09800 GETNAME(TRUE,S,FUNNAM);
09900 I←INTSCAN(S,BREAK);
10000 GETNAME(TRUE,S,FUNNAM);
10100 J←INTSCAN(S,BREAK);
10200 SAY_WAIT;
10300 ARM_CONO(XV,YV,ZV,I,J);
10400 END;
10500 END "CONO";
10600
10700 BEGIN"END"
10800 SAY_WAIT;
10900 FOR I←1 STEP 1 UNTIL 10 DO SAVE_NAME[I]←NULL;
11000 MSN←0;
11100 CLOSE_TRAJECTORY;
11200 FILE←NULL;
11300 END"END";
11400
00100 IF LENGTH(FILE) THEN BEGIN FLUSH(0,LAST_ARM);FRST_OPEN←TRUE END;
00200
00300 BEGIN "PROCEED"
00350 S←SIMIO(ONE_LINE);
00360 I←INTSCAN(S,BREAK);
00400 SAY_WAIT;
00500 DO_PROCEED(I);
00600 AEF←TRUE;
00610 GO TO GET1;
00700 END"PROCEED";
00800
00900 BEGIN"PROTO"
01000 GETNAME(FALSE,S,VECTNAM);
01100 GLOBAL ERASE INSTANCE⊗ANY≡TEST_BLOCK;
01200 IF EQU(S,"WEDGE")THEN GLOBAL MAKE INSTANCE⊗WEDGE124≡TEST_BLOCK ELSE
01300 IF EQU(S,"RPP")THEN GLOBAL MAKE INSTANCE⊗RPP112≡TEST_BLOCK ELSE
01400 GLOBAL MAKE INSTANCE⊗CUBE≡TEST_BLOCK;
01500 END"PROTO";
01600
01700 BEGIN"FILE"
01800 GETNAME(FALSE,OFILE,VECTNAM);
01900 END"FILE";
02000
02100 BEGIN"I"
02200 IF ¬MAC ∧ CHAN=1 THEN FOR I←1 STEP 1 UNTIL 6 DO OUTSTR(CVF(ARM_VECTOR[I]));
02300 IF ¬MAC ∧ CHAN=1 THEN OUTSTR(CRLF);
02400 END"I";
02500
02600 BEGIN "MOVEINST"
02700 IF ¬READT(XT,S,"INSTANCE TRANSFORM DOSN'T EXIST")THEN GO TO GET;
02800 ARRTRAN ( GLOBAL DATUM(TEST_BLOCK),XT);
02900 IF ¬READT(XT,S,"NEW TRANSFORM DOSN'T EXIST")THEN GO TO GET;
03000 IF ¬READV(YV,S,"INTERMEDIATE POSITION DOSN'T EXIST")THEN GO TO GET;
03100 SAY_WAIT;
03200 OPEN_ONE;
03300 ISSUE(7,"HAND","MOVE",MESSAGE MOVE_INSTANCE(TEST_BLOCK,XT,YV,ARM_PLAN));
03400 IF ARM_PLAN ≤0 THEN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"SORRY "&CVS(ARM_PLAN)&CRLF)
03500 ELSE BEGIN
03600 IF ¬MAC ∧ CHAN=1 THEN OUTSTR(CVS(ARM_PLAN/2)&" MOVE"&CRLF);
03700 FOR I←1 STEP 1 UNTIL 3*ARM_PLAN DO
03800 QUEUE('600, GET_ENTRY('120,NULL,"HAND",NULL));
03900 END;
04000 END "MOVEINST";
04100
00100 BEGIN"LINK"
00200 SAFE OWN REAL ARRAY T[1:4,1:4];
00300 GETNAME(TRUE,S,FUNNAM);
00400 I←INTSCAN(S,BREAK);
00500 IF I<3 ∨ I>6 THEN BEGIN OUTSTR("THAT LINK IS NOT AVAILABLE"&CRLF);GO TO GET END;
00600 ARRBLT(T[1,1],ARM_LINK[I,1,1],16);
00700 T[1,4]←T[1,4]/TSX;
00800 T[2,4]←T[2,4]/TSY;
00900 PMAT(NULL,T);
01000 END"LINK";
01100
01200 OUTSTR(CVF(GRASP)&CRLF);
01300
01400 BEGIN"WEIGHT"
01500 PRELOAD_WITH 0,0,-1,0,0,0;SAFE OWN REAL ARRAY ONE_OZ[1:6];
01600 SAFE OWN REAL ARRAY TORQUE[1:6];
01700 INTEGER I; REAL WR,WO;
01800 LABEL FIND;
01900 FIND: FORCE(TORQUE,ONE_OZ);
02000 WR←WO←0;
02100 FOR I←1 STEP 1 UNTIL 6 DO BEGIN
02200 WR←WR+TORQUE[I]*TORQUE[I];
02300 WO←WO-ARM_TORQUE[I]*TORQUE[I];
02400 END;
02500 OUTSTR(CVF(WO/WR)&" OZS."&CRLF);
02600 END;"WEIGHT"
02700
02800 BEGIN"WOBBLE"
02900 GETNAME(TRUE,S,FUNNAM);
03000 R←REALSCAN(S,BREAK);
03100 SAY_WAIT;
03200 OPEN_ONE;
03300 WOBBLE_HAND(R);
03400 END"WOBBLE";
03500
03600 BEGIN "POS"
03700 SAFE OWN REAL ARRAY T[1:4,1:4];
03800 SAY_WAIT;
03900 ARM_POSITION;
04000 ARRBLT(T[1,1],ARM_LINK[6,1,1],16);
04100 T[1,4]←T[1,4]/TSX;
04200 T[2,4]←T[2,4]/TSY;
04300 PMAT(NULL,T);
04400 END "POS";
04500
04600 BEGIN"SKIPN"
04700 STRING SL;
04800 SL←SIMIO(ONE_LINE);
04900 I←CVO(SL);
05000 SAY_WAIT;
05100 ARM_SKIPN(I);
05200 GO TO GET1
05300 END"SKIPN";
05400
05500 BEGIN"SKIPS"
05600 STRING SL;
05700 SL←SIMIO(ONE_LINE);
05800 I←CVO(SL);
05900 SAY_WAIT;
06000 ARM_SKIPS(I);
06100 GO TO GET1
06200 END"SKIPS";
06300
00100 BEGIN "DEFINE"
00200 STRING ARRAY ARG[1:10];
00300 INTEGER TMN;
00500 I←GETNAME(FALSE,S,FUNNAM);
00600 IF LENGTH(FUNNAM[I]) THEN OUTSTR(S&" MACRO NAME RESERVED WORD"&CRLF);
00700 FOR TMN←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[TMN]) THEN DONE;
00800 IF TMN>FMN THEN MACRO_NAME[TMN]←S;
00900 MACRO_FORMAL[TMN]←S←SIMIO(ONE_LINE);
01000 J←0;
01100 WHILE LENGTH(S)
01200 DO BEGIN SCAN(S,HEAD,BREAK);
01300 IF BREAK=";" THEN DONE;
01400 SL←SCAN(S,ID,BREAK);
01500 IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
01600 PUSH_FORMAT(0,0);
01700 MACRO_DEFN[TMN]←NULL;
01800 WHILE TRUE
01900 DO BEGIN
02000 IF ¬MAC ∧ CHAN=1 THEN OUTSTR("*");
02100 S←SIMIO(ONE_LINE);
02200 IF ¬LENGTH(S) THEN DONE;
02300 WHILE LENGTH(S) DO BEGIN
02400 SCAN(S,SOME,BREAK);
02500 IF BREAK=";" THEN DONE;
02600 IF "A" ≤ BREAK ≤ "Z"
02700 THEN BEGIN SL←SCAN(S,ID,BREAK);
02800 FOR I←1 STEP 1 UNTIL J
02900 DO IF EQU(SL,ARG[I])
03000 THEN BEGIN SL←"$"&CVS(I);
03100 DONE END;
03200 IF BREAK=":" THEN SL←SL&":";
03300 IF BREAK="+" ∨ BREAK="-" THEN S←BREAK&S END
03400 ELSE SL←SCAN(S,NNUMS,BREAK);
03450 IF EQU(SL,"-") THEN S←BREAK&S;
03500 MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&SL&(IF LENGTH(S) ∧ ¬EQU(SL,"-") THEN " " ELSE NULL);
03600 IF BREAK=";" THEN DONE;
03700 END;
03800 MACRO_DEFN[TMN]←MACRO_DEFN[TMN]&'15&'12;
03900 END;
04000 POP_FORMAT;
04100 OUTSTR(MACRO_NAME[TMN]&(IF TMN≤FMN THEN " REDEFINED" ELSE " DEFINED")&CRLF);
04200 IF TMN>FMN THEN FMN←TMN;
04300 GO TO GET1;
04400 END "DEFINE";
04500
00100 BEGIN "DUMP"
00200 STRING ARRAY ARG[1:10];
00300 OUTSTR("FILE NAME"&CRLF);
00400 SIMIO(HEAD);
00500 S←SIMIO(ID);
00600 IF BREAK="." THEN S←S&"."&SIMIO(ID) ELSE S←S&".HAL";
00700 IF BREAK="[" THEN S←S&"["&SIMIO(RSB);
00800 OPEN(CHAN←CHAN+1,"DSK",0,0,3,120,BREAK,EOF);
00900 ENTER(CHAN,S,EOF);
01000 FOR I←0 STEP 1 UNTIL '77 DO
01100 IF LENGTH(TRANSNAM[I]) THEN BEGIN
01200 OUT(CHAN,"TRANS "&TRANSNAM[I]&" ");
01300 ARRBLT(DIR[1],DATA_BASE[TRANSNUM[I],1],6);
01400 FOR J←1 STEP 1 UNTIL 6 DO OUT(CHAN,CVF(DIR[J]));
01500 OUT(CHAN,CRLF);
01600 END;
01700 OUT(CHAN,CRLF&CRLF);
01800 FOR I←0 STEP 1 UNTIL '77 DO
01900 IF LENGTH(VECTNAM[I]) ∧ VECTNUM[I] THEN BEGIN
02000 OUT(CHAN,"VECT "&VECTNAM[I]&" ");
02100 ARRBLT(DIR[1],DATA_BASE[VECTNUM[I],1],3);
02200 FOR J←1 STEP 1 UNTIL 3 DO OUT(CHAN,CVF(DIR[J]));
02300 OUT(CHAN,CRLF);
02400 END;
02500 OUT(CHAN,CRLF&CRLF);
02600 FOR I←1 STEP 1 UNTIL FMN DO BEGIN
02700 OUT(CHAN,"DEFINE "&MACRO_NAME[I]&" ");
02800 OUT(CHAN,S←MACRO_FORMAL[I]&"
02900 ");
03000 J←0;
03100 WHILE LENGTH(S)
03200 DO BEGIN SCAN(S,HEAD,BREAK);
03300 IF BREAK=";" THEN DONE;
03400 SL←SCAN(S,ID,BREAK);
03500 IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
03600 S←MACRO_DEFN[I];
03700 WHILE LENGTH(S) DO BEGIN
03800 OUT(CHAN,SCAN(S,DOLLAR,BREAK));
03900 IF LENGTH(S) THEN OUT(CHAN,ARG[INTSCAN(S,BREAK)]);
04000 IF BREAK='12 THEN OUT(CHAN,'15);
04100 END;
04200 OUT(CHAN,CRLF&CRLF);
04300 END;
04400 RELEASE(CHAN);
04500 CHAN←CHAN-1;
04600 END "DUMP";
04700
00100 BEGIN"SET"
00200 LABEL L1;
00300 INTEGER CELL;
00400 GETNAME(FALSE,SL,VECTNAM);
00500 FOR CELL←1 STEP 1 UNTIL MSN DO IF EQU(SL,SAVE_NAME[CELL]) THEN GO TO L1;
00600 FOR CELL←1 STEP 1 UNTIL 10 DO IF ¬LENGTH(SAVE_NAME[CELL])THEN GO TO L1;
00700 OUTSTR(FILE_NAME[CHAN]&LINE_NO&"NO FREE SAVE CELL"&CRLF);
00800 GO TO GET;
00900 L1: IF ¬READV(XV,S,"DX DY DZ DOSN'T EXIST") THEN GO TO GET;
01000 SAY_WAIT;
01100 OPEN_ONE;
01200 SET_ARM(CELL,XV);
01300 SAVE_NAME[CELL]←SL;
01400 IF CELL>MSN THEN MSN←CELL;
01500 END"SET";
01600
00100 BEGIN "EDIT"
00200 STRING SC,SO,SN,SS;
00300 INTEGER REP;
00400 STRING ARRAY ARG[1:10];
00500 PROCEDURE LINED(REFERENCE STRING S);
00600 BEGIN STRING ST,SE;
00700 LABEL L1,L2;
00800 SE←S;
00900 S←NULL;
01000 L1: IF (REP←REP-1)≤0 THEN BEGIN
01005 IF SC="F" THEN BEGIN ST←SE;
01007 S←SCAN(ST,ONE_LINE,I);
01010 WHILE LENGTH(S) DO BEGIN SCAN(S,SOME,I);
01015 IF EQU(SS,SCAN(S,DEL,I)) THEN BEGIN S←NULL;GO TO L2 END END;
01025 S←SE;
01030 RETURN END;
01050 L2: OUTSTR(SE&"?");
01100 SC←INCHWL;
01200 ST←SCAN(SC,HEAD,BREAK);
01300 REP←INTSCAN(ST,BREAK);
01400 END;
01405 IF SC="F" THEN BEGIN ST←SC[2 TO ∞];IF LENGTH(ST) THEN SS←ST END;
01500 IF SC="I" THEN BEGIN S←S&SE;OUTSTR("*");
01550 IF ¬(SE←INCHWL)THEN BEGIN OUTSTR("A BLANK LINE TRY AGAIN"&'15&'12&"*");
01562 SE←INCHWL END;
01575 SE←SE&'15&'12;GO TO L1 END;
01600 IF SC="R" THEN BEGIN OUTSTR("*");
01625 IF ¬(SE←INCHWL)THEN BEGIN OUTSTR("A BLANK LINE TRY AGAIN"&'15&'12&"*");
01633 SE←INCHWL END;
01641 SE←SE&'15&'12;
01650 IF REP=1 THEN REP←0;
01700 IF ¬REP THEN GO TO L1 END;
01800 IF SC≠"D" THEN S←S&SE;
01900 END;
02000
02100 IF BREAK≠'15 THEN GETNAME(FALSE,EDIT_NAME,FUNNAM);
02200 FOR I←1 STEP 1 UNTIL FMN DO IF EQU(EDIT_NAME,MACRO_NAME[I]) THEN BEGIN
02300 S←"DEFINE "&MACRO_NAME[I]&" "&MACRO_FORMAL[I]&"
02400 ";
02500 MAC←MAC+1;
02600 REP←0;
02605 SS←SC←NULL;
02700 LINED(S);
02800 MACRO_SOURCE[MAC]←S;
02900 J←0;
03000 S←MACRO_FORMAL[I];
03100 WHILE LENGTH(S)
03200 DO BEGIN SCAN(S,HEAD,BREAK);
03300 IF BREAK=";" THEN DONE;
03400 SL←SCAN(S,ID,BREAK);
03500 IF LENGTH(SL) THEN ARG[J←J+1]←SL END;
03600 S←MACRO_DEFN[I];
03700 SO←NULL;
03800 WHILE LENGTH(S) DO BEGIN
03900 SO←SO&SCAN(S,DOLLAR,BREAK);
04000 IF LENGTH(S) THEN SO←SO&ARG[INTSCAN(S,BREAK)];
04100 IF BREAK='12 THEN SO←SO&'15;
04200 END;
04300 SN←NULL;
04400 WHILE LENGTH(SO) DO BEGIN LINED(S←SCAN(SO,ONE_LINE,BREAK)&"
04500 ");
04600 SN←SN&S END;
04700 MACRO_SOURCE[MAC]←MACRO_SOURCE[MAC]&SN;
04800 MAC_TOP[MAC]←MAC_FREE;
04900 BBEG[MAC]←PTR3+1;
05000 LLAB[MAC]←FREEL+1;
05100 OUTSTR("TYPE ?
05200 ");
05300 IF LENGTH(INCHWL) THEN OUTSTR(MACRO_SOURCE[MAC]&"
05400 ");
05500 GO TO GET1;
05600 END;
05700 END"EDIT";
05800
05900 BEGIN "NNUL" SAY_WAIT;NO_NULL END"NNUL";
06000
06100 BEGIN "SEARCH"
06200 GETNAME(TRUE,S,FUNNAM);
06300 R←REALSCAN(S,BREAK);
06400 SAY_WAIT;
06500 OPEN_ONE;
06600 SEARCH_ARM(R);
06700 END"SEARCH";
06800
06900 BEGIN"AOJ"
07000 STRING SC;
07100 CODE_LINE[PTR3+1]←LINE_NO;
07200 S←SC←SIMIO(ONE_LINE);
07300 SCAN(SC,HEAD,J);
07400 IF LENGTH(REF[PTR3+1]←SCAN(SC,ID,J))
07500 THEN BEGIN SC←BREAK&SC;
07600 I←INTSCAN(SC,J) END ELSE I←INTSCAN(S,J);
07700 SAY_WAIT;
07800 OPEN_ONE;
07900 ARM_AOJ(I);
08000 GO TO GET1;
08100 END"AOJ";
08200
08300 BEGIN "SLAVE" SAY_WAIT; SLAVE_ARM END "SLAVE";
08400
00100 IFC GRAPHICS THENC
00200 BEGIN "DISPLAY"
00300 SAFE INTEGER ARRAY DISPLY[1:'3000];
00400 LABEL TOP;
00500 INTEGER POG;
00600 SAFE INTEGER ARRAY FDATA[0:'2200];
00700 STRING SIMPLE PROCEDURE SCAN_DATA(INTEGER TL,TU;STRING IND;SIMPLE PROCEDURE UP);
00800 BEGIN INTEGER ERROR,TICK,REQD,THIS,N;
00900 INTEGER MISSED;
01000 BOOLEAN FIRST;
01100 LABEL NEXT;
01200 LOOKUP('17,DFILE&".TMP",EOF);
01300 IF EOF THEN RETURN("FILE NOT FOUND");
01400 REQD←CVSIX(IND);
01500 TICK←CVSIX("TICK");
01600 ERROR←CVSIX("ERROR");
01700 TIME←-1;
01800 FIRST←TRUE;
01900 MISSED←0;
02000 PTR←0;
02100 BP←0;
02200 HIT←0;
02300 ARRYIN('17,FDATA[0],'200);
02400 DO BEGIN "READ_LOOP"
02500 ARRYIN('17,FDATA['200],'2000);
02600 DO BEGIN "ITEM_LOOP"
02700 THIS←FDATA[PTR] LAND '777777777700;
02800 IF ¬THIS THEN RETURN(NULL);
02900 IF THIS=TICK THEN BEGIN
03000 MISSED←0;
03100 TIME←TIME+1;
03200 IF TIME<TL THEN GO TO NEXT;
03300 IF TIME>TU THEN RETURN(NULL);
03400 HIT←HIT+1;
03500 IF MODULUS<2 ∨ ¬(HIT MOD MODULUS) THEN BEGIN
03600 BUFFER[BP+1]←BUFFER[BP];
03700 BP←BP+1;
03800 END;
03900 END;
04000 IF THIS=REQD THEN BEGIN
04100 UP;
04200 IF FIRST THEN BEGIN
04300 BUFFER[1]←BUFFER[BP];
04400 ARRBLT(BUFFER[2],BUFFER[1],BP-2);
04500 FIRST←FALSE;
04600 END;
04700 END;
04800 NEXT: IF(N←FDATA[PTR] LAND '77)>'37 ∨ THIS=ERROR THEN
04900 BEGIN MISSED←-1;
05000 OUTSTR(CVS(TIME)&" DATA MISSED");
05100 END;
05200 PTR←PTR+1+(IF MISSED THEN 0 ELSE N);
05300 END UNTIL PTR>'1777;
05400 PTR←PTR-'2000;
05500 ARRBLT(FDATA[0],FDATA['2000],'200);
05600 END UNTIL EOF;
05700 RETURN("END OF FILE");
05800 END"SCAN_DATA";
05900
06000 PROCEDURE WHEN;
06100 BEGIN
06200 INTEGER I;
06300 PRELOAD_WITH "OPEN_HAND","CLOSE_HAND","WAIT_ARM","PLACE_ARM","CHANGE_ARM","SET_TOUCH","FORCE_ARM";
06400 SAFE OWN STRING ARRAY FUNCTION[1:7];
06500 IF (I←FDATA[PTR+1] LAND '777777) THEN SM←SM&CVS(TIME)&" "&FUNCTION[I]&CRLF ELSE
06600 IF FDATA[PTR+1] LAND '10000000 THEN SM←SM&CVS(TIME)&" "&"NULL_ARM"&CRLF ELSE
06700 IF FDATA[PTR+1] LAND '20000000 THEN SM←SM&CVS(TIME)&" "&"MOVE_ARM"&CRLF;
06800 END;
06900
07000 SIMPLE PROCEDURE REAL6;
07100 BEGIN
07200 INTEGER I;
07300 REAL R;
07400 I←FDATA[PTR+7-INDEX];
07500 START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
07600 BUFFER[BP]←R;
07700 END;
07800
07900 SIMPLE PROCEDURE REAL1;
08000 BEGIN
08100 INTEGER I;
08200 REAL R;
08300 I←FDATA[PTR+1];
08400 START_CODE MOVE 1,I;FMPR 1,FACTOR;MOVEM 1,R END;
08500 BUFFER[BP]←R;
08600 END;
08700
08800 SIMPLE PROCEDURE INT1;BUFFER[BP]←FDATA[PTR+1];
08900
09000 SIMPLE PROCEDURE INT6;
09100 BUFFER[BP]←FDATA[PTR+7-INDEX];
09200
09300 PROCEDURE BIGHT;
09400 BEGIN LABEL FOUND;
09500 INTEGER BITE,T,I,J,K;
09600 SAFE INTEGER ARRAY FEEL[1:2,1:2,1:4];
09700 START_CODE
09800 HRRZI 1,FDATA;
09900 HRR 1,(1);
10000 ADD 1,PTR;
10100 HRLI 1,'1400;
10200 MOVEM 1,BITE;
10300 END;
10400 FOR I←2 STEP -1 UNTIL 1 DO BEGIN"FINGER"
10500 FOR J←2 STEP -1 UNTIL 1 DO
10600 FOR K←4 STEP -1 UNTIL 1 DO
10700 IF INDEX=I ∧ TIP=J ∧ PAD=K THEN
10800 BEGIN"THE ONE"
10900 T←ILDB(BITE);
11000 START_CODE
11100 LABEL POS,BACK;
11200 MOVE 1,T;
11300 TRNE 1,'2000;
11400 JRST POS;
11500 TRZ 1,'774000;
11600 JRST BACK;
11700 POS: TDO 1,NMASK;
11800 BACK: MOVNM 1,T;
11900 END;
12000 GO TO FOUND;
12100 END "THE ONE" ELSE IBP(BITE);
12200 IBP(BITE);
12300 END "FINGER";
12400 FOUND: BUFFER[BP]←T;
12500 END;
12600 STRING SL;
00100 SL←SIMIO(ONE_LINE);
00200 SCAN(SL,HEAD,BREAK);
00300 IF ¬LENGTH(DFILE←SCAN(SL,ID,BREAK)) THEN DFILE←OFILE;
00400 OPEN('17,"DSK",'17,0,0,120,BREAK,EOF);
00500 MODULUS←1000;
00600 SM←"
00700 TIME FUNCTION"&CRLF;
00800 SETFORMAT(4,0);
00900 S11←SCAN_DATA(0,5000,"NEXT",WHEN);
01000 SM←SM&CVS(TIME)&" "&S11&CRLF;
01100 OUTSTR(SM);
01200 OUTSTR("DISPLAY, FUNCTION, FROM, TO ?"&CRLF);
01300 SETFORMAT(0,0);
01400 WHILE TRUE DO BEGIN
01500 INPUT(1,HEAD);S11←INPUT(1,ID);
01600 IF EQU(S11,"X") THEN DONE;
01700 IF EQU(S11,"N") THEN BEGIN RELEASE('17);GO TO GET END;
01800 IF EQU(S11,"C") THEN BEGIN DPYCLR;RELEASE('17);GO TO GET END;
01900 IF EQU(S11,"P") THEN BEGIN
02000 STRING FILNAM;
02100 INTEGER FLG,CHN;
02200 CHN ← 14;
02300 OPEN(CHN,"DSK",8,0,3,0,0,0);
02400 DO BEGIN
02500 OUTSTR(13&10&"PLOT FILE = ");
02600 FILNAM ← INCHWL;
02700 ENTER(CHN,FILNAM&".PLT",FLG);
02800 END UNTIL ¬FLG;
02900 ARRYOUT(CHN,DISPLY[1],DISPLY[2]);
03000 RELEASE(CHN);
03100 GO TO TOP;
03200 END;
03300 INPUT(1,HEAD);FUNCTION←INPUT(1,ID);
03400 IF EQU(S11,"D")THEN BEGIN
03500 LL←INTIN(1);
03600 UL←INTIN(1);
03700 MODULUS←1+(UL-LL)%100;
03800 DPYCLR;
03900 POG←GETPOG;
04000 DPYSET(DISPLY);
04100 AIVECT(-511,450);
04200 END;
04300 IF EQU(FUNCTION,"THETA")THEN BEGIN
04400 OUTSTR("INDEX ?"&CRLF);
04500 INDEX←INTIN(1);
04600 FACTOR←THFAC[INDEX];
04700 SCAN_DATA(LL,UL,"THETA",REAL6);
04800 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
04900 "ERROR "&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
05000 DPYOUT(POG);
05100 GO TO TOP;
05200 END;
05300
05400 IF EQU(FUNCTION,"MOTOR")THEN BEGIN
05500 OUTSTR("INDEX ?"&CRLF);
05600 INDEX←INTIN(1);
05700 SCAN_DATA(LL,UL,"DAC",INT6);
05800 FOR I←1 STEP 1 UNTIL BP DO BUFFER[I]←BUFFER[I]*300/'776000;
05900 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
06000 "MOTOR "&CVS(INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
06100 DPYOUT(POG);
06200 GO TO TOP;
06300 END;
06400 IF EQU(FUNCTION,"DRIVE")THEN BEGIN
06500 OUTSTR("INDEX ?"&CRLF);
06600 INDEX←7-INTIN(1);
06700 FACTOR←10.0;
06800 SCAN_DATA(LL,UL,"BACK",REAL6);
06900 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
07000 "DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
07100 BP←HIT←0;
07200 SCAN_DATA(LL,UL,"FORD",REAL6);
07300 ARRGRF(BUFFER,1,BP,-300,-300,0,700,"T/"&CVS(MODULUS),
07400 "DRIVE "&CVS(7-INDEX)&" FROM "&CVS(LL)&" TO "&CVS(UL));
07500 DPYOUT(POG);
07600 GO TO TOP;
07700 END;
07800 IF EQU(FUNCTION,"HAND")THEN BEGIN
07900 FACTOR←100.0;
08000 SCAN_DATA(LL,UL,"HAND",REAL1);
08100 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
08200 "HAND FROM "&CVS(LL)&" TO "&CVS(UL));
08300 DPYOUT(POG);
08400 GO TO TOP;
08500 END;
08600 IF EQU(FUNCTION,"TIME")THEN BEGIN
08700 SCAN_DATA(LL,UL,"TICK",INT1);
08800 ARRGRF(BUFFER,1,BP,-300,-300,800,700,"T/"&CVS(MODULUS),
08900 "TIME FROM "&CVS(LL)&" TO "&CVS(UL));
09000 DPYOUT(POG);
09100 GO TO TOP;
09200 END;
09300 IF EQU(FUNCTION,"TOUCH")THEN BEGIN
09400 OUTSTR("FINGER, TIP ?"&CRLF);
09500 INDEX←INTIN(1);
09600 TIP←INTIN(1);
09700 FOR PAD←1 STEP 1 UNTIL 4 DO BEGIN
09800 SCAN_DATA(LL,UL,"TOUCH",BIGHT);
09900 ARRGRF(BUFFER,1,BP,-300,-300+(PAD-1)*180,800,150,"T/"&CVS(MODULUS),
10000 "TOUCH FROM "&CVS(LL)&" TO "&CVS(UL));
10100 END;
10200 DPYOUT(POG);
10300 GO TO TOP;
10400 END;
10500 OUTSTR("UNRECOGINZED COMMAND"&CRLF);
10600 TOP:END;
10700 END"DISPLAY";
10800 ENDC
10900
00100 END ELSE
00200 BEGIN
00300 FOR I←1 STEP 1 UNTIL FMN DO IF EQU(S,MACRO_NAME[I])
00400 THEN BEGIN
00500 S←SIMIO(ONE_LINE);
00600 OUTSTR(MACRO_NAME[I]&CRLF);
00700 MAC←MAC+1;
00800 MACRO_SOURCE[MAC]←MACRO_DEFN[I];
00900 MAC_TOP[MAC]←MAC_FREE;
01000 WHILE LENGTH(S) DO BEGIN
01100 SCAN(S,SOME,BREAK);
01200 IF BREAK="$"
01300 THEN BEGIN I←INTSCAN(S,BREAK);
01400 I←I+MAC_TOP[MAC-1];
01500 IF I<1 ∨ I> MAC_TOP[MAC]
01600 THEN BEGIN OUTSTR(FILE_NAME[CHAN]&LINE_NO&"MACRO PARAMETER OUT OF RANGE"&'15&'12);
01700 GO TO GET END;
01800 SL←MAC_PAR[I] END
01900 ELSE SL←IF "A"≤ BREAK ≤"Z" THEN SCAN(S,ID,I) ELSE SCAN(S,NNUMS,I);
02000 IF LENGTH(SL) THEN MAC_PAR[MAC_FREE←MAC_FREE+1]←SL END;
02100 BBEG[MAC]←PTR3+1;
02200 LLAB[MAC]←FREEL+1;
02300 GO TO GET1;
02400 END;
02500
02600 OUTSTR(FILE_NAME[CHAN]&LINE_NO&"UNRECOGINIZED COMMAND"&CRLF);
02700 END;
02800 GO TO GET;
02900 ENDC
03000 END;
03100